home *** CD-ROM | disk | FTP | other *** search
/ PC Open 101 / PC Open 101 CD 1.bin / CD1 / INTERNET / EMAIL / pop file / setup.exe / POPFile / Loader.pm < prev    next >
Encoding:
Perl POD Document  |  2004-09-03  |  26.8 KB  |  896 lines
  1. package POPFile::Loader;
  2.  
  3. #----------------------------------------------------------------------------
  4. #
  5. # Loader.pm --- API for loading POPFile loadable modules and
  6. # encapsulating POPFile application tasks
  7. #
  8. # Subroutine names beginning with CORE indicate a subroutine designed
  9. # for exclusive use of POPFile's core application (popfile.pl).
  10. #
  11. # Subroutines not so marked are suitable for use by POPFile-based
  12. # utilities to assist in loading and executing modules
  13. #
  14. # Copyright (c) 2001-2004 John Graham-Cumming
  15. #
  16. #   This file is part of POPFile
  17. #
  18. #   POPFile is free software; you can redistribute it and/or modify
  19. #   it under the terms of the GNU General Public License as published by
  20. #   the Free Software Foundation; either version 2 of the License, or
  21. #   (at your option) any later version.
  22. #
  23. #   POPFile is distributed in the hope that it will be useful,
  24. #   but WITHOUT ANY WARRANTY; without even the implied warranty of
  25. #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  26. #   GNU General Public License for more details.
  27. #
  28. #   You should have received a copy of the GNU General Public License
  29. #   along with POPFile; if not, write to the Free Software
  30. #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  31. #
  32. #   Created by     Sam Schinke (sschinke@users.sourceforge.net)
  33. #
  34. #----------------------------------------------------------------------------
  35.  
  36. #----------------------------------------------------------------------------
  37. # new
  38. #
  39. #   Class new() function
  40. #----------------------------------------------------------------------------
  41. sub new
  42. {
  43.     my $type = shift;
  44.     my $self;
  45.  
  46.     # The POPFile classes are stored by reference in the components
  47.     # hash, the top level key is the type of the component (see
  48.     # CORE_load_directory_modules) and then the name of the component
  49.     # derived from calls to each loadable modules name() method and
  50.     # which points to the actual module
  51.  
  52.     $self->{components__} = {};
  53.  
  54.     # A handy boolean that tells us whether we are alive or not.  When
  55.     # this is set to 1 then the proxy works normally, when set to 0
  56.     # (typically by the aborting() function called from a signal) then
  57.     # we will terminate gracefully
  58.  
  59.     $self->{alive__} = 1;
  60.  
  61.     # This must be 1 for POPFile::Loader to create any output on STDOUT
  62.  
  63.     $self->{debug__} = 1;
  64.  
  65.     # This stuff lets us do some things in a way that tolerates some
  66.     # window-isms
  67.  
  68.     $self->{on_windows__} = 0;
  69.  
  70.     if ( $^O eq 'MSWin32' ) {
  71.         require v5.8.0;
  72.         $self->{on_windows__} = 1;
  73.     }
  74.  
  75.     # See CORE_loader_init below for an explanation of these
  76.  
  77.     $self->{aborting__}     = '';
  78.     $self->{pipeready__}    = '';
  79.     $self->{forker__}       = '';
  80.     $self->{reaper__}       = '';
  81.  
  82.     # POPFile's version number as individual numbers and as
  83.     # string
  84.  
  85.     $self->{major_version__}  = '?';
  86.     $self->{minor_version__}  = '?';
  87.     $self->{build_version__}  = '?';
  88.     $self->{version_string__} = '';
  89.  
  90.     # Where POPFile is installed
  91.  
  92.     $self->{popfile_root__} = './';
  93.  
  94.     bless $self, $type;
  95.  
  96.     return $self;
  97. }
  98.  
  99. #----------------------------------------------------------------------------
  100. #
  101. # CORE_loader_init
  102. #
  103. # Initialize things only needed in CORE
  104. #
  105. #----------------------------------------------------------------------------
  106. sub CORE_loader_init
  107. {
  108.     my ( $self ) = @_;
  109.  
  110.     if ( defined( $ENV{POPFILE_ROOT} ) ) {
  111.         $self->{popfile_root__} = $ENV{POPFILE_ROOT};
  112.     }
  113.  
  114.     # These anonymous subroutine references allow us to call these important
  115.     # functions from anywhere using the reference, granting internal access
  116.     # to $self, without exposing $self to the unwashed. No reference to
  117.     # POPFile::Loader is needed by the caller
  118.  
  119.     $self->{aborting__} = sub { $self->CORE_aborting(@_) };
  120.     $self->{pipeready__} = sub { $self->pipeready(@_) };
  121.     $self->{forker__} = sub { $self->CORE_forker(@_) };
  122.     $self->{reaper__} = sub { $self->CORE_reaper(@_) };
  123.  
  124.     # See if there's a file named popfile_version that contains the
  125.     # POPFile version number
  126.  
  127.     my $version_file = $self->root_path__( 'POPFile/popfile_version' );
  128.  
  129.     if ( -e $version_file ) {
  130.         open VER, "<$version_file";
  131.         my $major = int(<VER>);
  132.         my $minor = int(<VER>);
  133.         my $rev   = int(<VER>);
  134.         close VER;
  135.         $self->CORE_version( $major, $minor, $rev );
  136.     }
  137.  
  138.     print "\nPOPFile Engine loading\n" if $self->{debug__};
  139. }
  140.  
  141. #----------------------------------------------------------------------------
  142. #
  143. # CORE_aborting
  144. #
  145. # Called if we are going to be aborted or are being asked to abort our
  146. # operation. Sets the alive flag to 0 that will cause us to abort at
  147. # the next convenient moment
  148. #
  149. #----------------------------------------------------------------------------
  150. sub CORE_aborting
  151. {
  152.     my ( $self ) = @_;
  153.  
  154.     $self->{alive__} = 0;
  155.     foreach my $type (sort keys %{$self->{components__}}) {
  156.         foreach my $name (sort keys %{$self->{components__}{$type}}) {
  157.             $self->{components__}{$type}{$name}->alive(0);
  158.         }
  159.     }
  160. }
  161.  
  162. #----------------------------------------------------------------------------
  163. #
  164. # pipeready
  165. #
  166. # Returns 1 if there is data available to be read on the passed in
  167. # pipe handle
  168. #
  169. # $pipe        Pipe handle
  170. #
  171. #----------------------------------------------------------------------------
  172. sub pipeready
  173. {
  174.     my ( $self, $pipe ) = @_;
  175.  
  176.     # Check that the $pipe is still a valid handle
  177.  
  178.     if ( !defined( $pipe ) ) {
  179.         return 0;
  180.     }
  181.  
  182.     if ( $self->{on_windows__} ) {
  183.  
  184.         # I am NOT doing a select() here because that does not work
  185.         # on Perl running on Windows.  -s returns the "size" of the file
  186.         # (in this case a pipe) and will be non-zero if there is data to read
  187.  
  188.         return ( ( -s $pipe ) > 0 );
  189.     } else {
  190.  
  191.         # Here I do a select because we are not running on Windows where
  192.         # you can't select() on a pipe
  193.  
  194.         my $rin = '';
  195.         vec( $rin, fileno( $pipe ), 1 ) = 1;
  196.         my $ready = select( $rin, undef, undef, 0.01 );
  197.         return ( $ready > 0 );
  198.     }
  199. }
  200.  
  201. #----------------------------------------------------------------------------
  202. #
  203. # CORE_reaper
  204. #
  205. # Called if we get SIGCHLD and asks each module to do whatever reaping
  206. # is needed
  207. #
  208. #----------------------------------------------------------------------------
  209. sub CORE_reaper
  210. {
  211.     my ( $self ) = @_;
  212.  
  213.     foreach my $type (sort keys %{$self->{components__}}) {
  214.         foreach my $name (sort keys %{$self->{components__}{$type}}) {
  215.             $self->{components__}{$type}{$name}->reaper();
  216.         }
  217.     }
  218.  
  219.     $SIG{CHLD} = $self->{reaper__};
  220. }
  221.  
  222. #----------------------------------------------------------------------------
  223. #
  224. # CORE_forker
  225. #
  226. # Called to fork POPFile.  Calls every module's forked function in the
  227. # child process to give then a chance to clean up
  228. #
  229. # Returns the return value from fork() and a file handle that form a
  230. # pipe in the direction child to parent.  There is no need to close
  231. # the file handles that are unused as would normally be the case with
  232. # a pipe and fork as forker takes care that in each process only one
  233. # file handle is open (be it the reader or the writer)
  234. #
  235. #----------------------------------------------------------------------------
  236. sub CORE_forker
  237. {
  238.     my ( $self ) = @_;
  239.  
  240.     # Tell all the modules that a fork is about to happen
  241.  
  242.     foreach my $type (sort keys %{$self->{components__}}) {
  243.         foreach my $name (sort keys %{$self->{components__}{$type}}) {
  244.             $self->{components__}{$type}{$name}->prefork();
  245.         }
  246.     }
  247.  
  248.     # Create the pipe that will be used to send data from the child to
  249.     # the parent process, $writer will be returned to the child
  250.     # process and $reader to the parent process
  251.  
  252.     pipe my $reader, my $writer;
  253.     my $pid = fork();
  254.  
  255.     # If fork() returns an undefined value then we failed to fork and are
  256.     # in serious trouble (probably out of resources) so we return undef
  257.  
  258.     if ( !defined( $pid ) ) {
  259.         close $reader;
  260.         close $writer;
  261.         return (undef, undef);
  262.     }
  263.  
  264.     # If fork returns a PID of 0 then we are in the child process so
  265.     # close the reading pipe file handle, inform all modules that are
  266.     # fork has occurred and then return 0 as the PID so that the
  267.     # caller knows that we are in the child
  268.  
  269.     if ( $pid == 0 ) {
  270.           foreach my $type (sort keys %{$self->{components__}}) {
  271.                foreach my $name (sort keys %{$self->{components__}{$type}}) {
  272.                  $self->{components__}{$type}{$name}->forked( $writer );
  273.               }
  274.         }
  275.  
  276.         close $reader;
  277.  
  278.         # Set autoflush on the write handle so that output goes
  279.         # straight through to the parent without buffering it until
  280.         # the socket closes
  281.  
  282.         use IO::Handle;
  283.         $writer->autoflush(1);
  284.  
  285.         return (0, $writer);
  286.     }
  287.  
  288.     # Reach here because we are in the parent process, close out the
  289.     # writer pipe file handle and return our PID (non-zero) indicating
  290.     # that this is the parent process
  291.  
  292.     foreach my $type (sort keys %{$self->{components__}}) {
  293.         foreach my $name (sort keys %{$self->{components__}{$type}}) {
  294.             $self->{components__}{$type}{$name}->postfork( $pid, $reader );
  295.         }
  296.     }
  297.  
  298.     close $writer;
  299.     return ($pid, $reader);
  300. }
  301.  
  302. #----------------------------------------------------------------------------
  303. #
  304. # CORE_load_directory_modules
  305. #
  306. # Called to load all the POPFile Loadable Modules (implemented as .pm
  307. # files with special comment on first line) in a specific subdirectory
  308. # and loads them into a structured components hash
  309. #
  310. # $directory   The directory to search for loadable modules
  311. # $type        The 'type' of module being loaded (e.g. proxy, core, ui) which
  312. # is used when fixing up references between modules (e.g. proxy
  313. # modules all need access to the classifier module) and for
  314. # structuring components hash
  315. #
  316. #----------------------------------------------------------------------------
  317. sub CORE_load_directory_modules
  318. {
  319.     my ( $self, $directory, $type ) = @_;
  320.  
  321.     print "\n         {$type:" if $self->{debug__};
  322.  
  323.     # Look for all the .pm files in named directory and then see which
  324.     # of them are POPFile modules indicated by the first line of the
  325.     # file being and comment (# POPFILE LOADABLE MODULE) and load that
  326.     # module into the %{$self->{components__}} hash getting the name
  327.     # from the module by calling name()
  328.  
  329.     opendir MODULES, $self->root_path__( $directory );
  330.  
  331.     while ( my $entry = readdir MODULES ) {
  332.         if ( $entry =~ /\.pm$/ ) {
  333.             $self->CORE_load_module( "$directory/$entry", $type );
  334.     }
  335.     }
  336.  
  337.     closedir MODULES;
  338.  
  339.     print '} ' if $self->{debug__};
  340. }
  341.  
  342. #----------------------------------------------------------------------------
  343. #
  344. # CORE_load_module
  345. #
  346. # Called to load a single POPFile Loadable Module (implemented as .pm
  347. # files with special comment on first line) and add it to the
  348. # components hash.
  349. #
  350. # Returns a handle to the module
  351. #
  352. # $module           The path of the module to load
  353. # $type             The 'type' of module being loaded (e.g. proxy, core, ui)
  354. #
  355. #----------------------------------------------------------------------------
  356. sub CORE_load_module
  357. {
  358.     my ( $self, $module, $type ) = @_;
  359.  
  360.     my $mod = $self->load_module_($module);
  361.  
  362.     if ( defined( $mod ) ) {
  363.         my $name = $mod->name();
  364.         print " $name" if $self->{debug__};
  365.         $self->{components__}{$type}{$name} = $mod;
  366.     }
  367.     return $mod;
  368. }
  369.  
  370. #----------------------------------------------------------------------------
  371. #
  372. # load_module_
  373. #
  374. # Called to load a single POPFile Loadable Module (implemented as .pm
  375. # files with special comment on first line. Returns a handle to the
  376. # module, undef if the module failed to load.  No internal
  377. # side-effects.
  378. #
  379. # $module           The path of the module to load
  380. #
  381. #----------------------------------------------------------------------------
  382. sub load_module_
  383. {
  384.     my ( $self, $module ) = @_;
  385.  
  386.     my $mod;
  387.  
  388.     if ( open MODULE, '<' . $self->root_path__( $module ) ) {
  389.         my $first = <MODULE>;
  390.         close MODULE;
  391.  
  392.         if ( $first =~ /^# POPFILE LOADABLE MODULE/ ) {
  393.             require $module;
  394.  
  395.             $module =~ s/\//::/;
  396.             $module =~ s/\.pm//;
  397.  
  398.             $mod = $module->new();
  399.         }
  400.     }
  401.     return $mod;
  402. }
  403.  
  404. #----------------------------------------------------------------------------
  405. #
  406. # CORE_signals
  407. #
  408. # Sets signals to ensure that POPFile handles OS and IPC events
  409. #
  410. # TODO: Figure out why windows POPFile doesn't seem to get SIGTERM
  411. # when windows shuts down
  412. #
  413. #----------------------------------------------------------------------------
  414. sub CORE_signals
  415. {
  416.     my ( $self ) = @_;
  417.  
  418.     # Redefine POPFile's signals
  419.  
  420.     $SIG{QUIT}  = $self->{aborting__};
  421.     $SIG{ABRT}  = $self->{aborting__};
  422.     $SIG{KILL}  = $self->{aborting__};
  423.     $SIG{STOP}  = $self->{aborting__};
  424.     $SIG{TERM}  = $self->{aborting__};
  425.     $SIG{INT}   = $self->{aborting__};
  426.  
  427.     # Yuck.  On Windows SIGCHLD isn't calling the reaper under
  428.     # ActiveState 5.8.0 so we detect Windows and ignore SIGCHLD and
  429.     # call the reaper code below
  430.  
  431.     $SIG{CHLD}  = $self->{on_windows__}?'IGNORE':$self->{reaper__};
  432.  
  433.     # I've seen spurious ALRM signals happen on Windows so here we for
  434.     # safety say that we want to ignore them
  435.  
  436.     $SIG{ALRM}  = 'IGNORE';
  437.  
  438.     # Ignore broken pipes
  439.  
  440.     $SIG{PIPE}  = 'IGNORE';
  441.  
  442.     return $SIG;
  443. }
  444.  
  445. #----------------------------------------------------------------------------
  446. #
  447. # CORE_platform_
  448. #
  449. # Loads POPFile's platform-specific code
  450. #
  451. #----------------------------------------------------------------------------
  452. sub CORE_platform_
  453. {
  454.     my ( $self ) = @_;
  455.  
  456.     # Look for a module called Platform::<platform> where <platform>
  457.     # is the value of $^O and if it exists then load it as a component
  458.     # of POPFile.  IN this way we can have platform specific code (or
  459.     # not) encapsulated.  Note that such a module needs to be a
  460.     # POPFile Loadable Module and a subclass of POPFile::Module to
  461.     # operate correctly
  462.  
  463.     my $platform = $^O;
  464.  
  465.     if ( -e $self->root_path__( "Platform/$platform.pm" ) ) {
  466.         print "\n         {core:" if $self->{debug__};
  467.  
  468.         $self->CORE_load_module( "Platform/$platform.pm",'core');
  469.  
  470.         print "}" if $self->{debug__};
  471.     }
  472. }
  473.  
  474. #----------------------------------------------------------------------------
  475. #
  476. # CORE_load
  477. #
  478. # Loads POPFile's modules
  479. #
  480. # noserver              Set to 1 if no servers (i.e. UI and proxies)
  481. #
  482. #----------------------------------------------------------------------------
  483. sub CORE_load
  484. {
  485.     my ( $self, $noserver ) = @_;
  486.  
  487.     # Create the main objects that form the core of POPFile.  Consists
  488.     # of the configuration modules, the classifier, the UI (currently
  489.     # HTML based), and the POP3 proxy.
  490.  
  491.     print "\n    Loading... " if $self->{debug__};
  492.  
  493.     # Do our platform-specific stuff
  494.  
  495.     $self->CORE_platform_();
  496.  
  497.     # populate our components hash
  498.  
  499.     $self->CORE_load_directory_modules( 'POPFile',    'core'       );
  500.     $self->CORE_load_directory_modules( 'Classifier', 'classifier' );
  501.  
  502.     if ( !$noserver ) {
  503.         $self->CORE_load_directory_modules( 'UI',         'interface' );
  504.         $self->CORE_load_directory_modules( 'Proxy',      'proxy'     );
  505.         $self->CORE_load_directory_modules( 'Services',   'services'    );
  506.     }
  507. }
  508.  
  509. #----------------------------------------------------------------------------
  510. #
  511. # CORE_link_components
  512. #
  513. # Links POPFile's modules together to allow them to make use of
  514. # each-other as objects
  515. #
  516. #----------------------------------------------------------------------------
  517. sub CORE_link_components
  518. {
  519.     my ( $self ) = @_;
  520.  
  521.     print "\n\nPOPFile Engine $self->{version_string__} starting" if $self->{debug__};
  522.  
  523.     # Link each of the main objects with the configuration object so
  524.     # that they can set their default parameters all or them also get
  525.     # access to the logger, version, and message-queue
  526.  
  527.     foreach my $type (sort keys %{$self->{components__}}) {
  528.         foreach my $name (sort keys %{$self->{components__}{$type}}) {
  529.             $self->{components__}{$type}{$name}->version(       scalar($self->CORE_version())                    );
  530.             $self->{components__}{$type}{$name}->configuration( $self->{components__}{core}{config} );
  531.             $self->{components__}{$type}{$name}->logger(        $self->{components__}{core}{logger} ) if ( $name ne 'logger' );
  532.             $self->{components__}{$type}{$name}->mq(            $self->{components__}{core}{mq}     );
  533.         }
  534.     }
  535.  
  536.     # All interface components need access to the classifier and history
  537.  
  538.     foreach my $name (sort keys %{$self->{components__}{interface}}) {
  539.         $self->{components__}{interface}{$name}->classifier( $self->{components__}{classifier}{bayes} );
  540.         $self->{components__}{interface}{$name}->history( $self->{components__}{core}{history} );
  541.     }
  542.  
  543.     foreach my $name (sort keys %{$self->{components__}{proxy}}) {
  544.         $self->{components__}{proxy}{$name}->classifier( $self->{components__}{classifier}{bayes} );
  545.         $self->{components__}{proxy}{$name}->history(    $self->{components__}{core}{history} );
  546.     }
  547.  
  548.     foreach my $name (sort keys %{$self->{components__}{services}}) {
  549.         $self->{components__}{services}{$name}->classifier( $self->{components__}{classifier}{bayes} );
  550.         $self->{components__}{services}{$name}->history(    $self->{components__}{core}{history} );
  551.     }
  552.  
  553.     # Classifier::Bayes and POPFile::History are friends and are aware
  554.     # of one another
  555.  
  556.     $self->{components__}{core}{history}->classifier( $self->{components__}{classifier}{bayes} );
  557.     $self->{components__}{classifier}{bayes}->history( $self->{components__}{core}{history} );
  558.  
  559.     $self->{components__}{classifier}{bayes}->{parser__}->mangle(
  560.         $self->{components__}{classifier}{wordmangle} );
  561. }
  562.  
  563. #----------------------------------------------------------------------------
  564. #
  565. # CORE_initialize
  566. #
  567. # Loops across POPFile's modules and initializes them
  568. #
  569. #----------------------------------------------------------------------------
  570. sub CORE_initialize
  571. {
  572.     my ( $self ) = @_;
  573.  
  574.     print "\n\n    Initializing... " if $self->{debug__};
  575.  
  576.     # Tell each module to initialize itself
  577.  
  578.     # Make sure that the core is started first.
  579.     my @c = ( 'core', grep {!/^core$/} sort keys %{$self->{components__}} );
  580.  
  581.     foreach my $type (@c) {
  582.         print "\n         {$type:" if $self->{debug__};
  583.         foreach my $name (sort keys %{$self->{components__}{$type}}) {
  584.             print " $name" if $self->{debug__};
  585.             flush STDOUT;
  586.  
  587.             my $code = $self->{components__}{$type}{$name}->initialize();
  588.  
  589.             if ( $code == 0 ) {
  590.                 die "Failed to start while initializing the $name module";
  591.             }
  592.  
  593.             if ( $code == 1 ) {
  594.                  $self->{components__}{$type}{$name}->alive(     1 );
  595.  
  596.                  $self->{components__}{$type}{$name}->forker(    $self->{forker__} );
  597.                  $self->{components__}{$type}{$name}->pipeready( $self->{pipeready__} );
  598.         }
  599.         }
  600.         print '} ' if $self->{debug__};
  601.     }
  602.     print "\n" if $self->{debug__};
  603. }
  604.  
  605. #----------------------------------------------------------------------------
  606. #
  607. # CORE_config
  608. #
  609. # Loads POPFile's configuration and command-line settings
  610. #
  611. #----------------------------------------------------------------------------
  612. sub CORE_config
  613. {
  614.     my ( $self ) = @_;
  615.  
  616.     # Load the configuration from disk and then apply any command line
  617.     # changes that override the saved configuration
  618.  
  619.     $self->{components__}{core}{config}->load_configuration();
  620.     return $self->{components__}{core}{config}->parse_command_line();
  621. }
  622.  
  623. #----------------------------------------------------------------------------
  624. #
  625. # CORE_start
  626. #
  627. # Loops across POPFile's modules and starts them
  628. #
  629. #----------------------------------------------------------------------------
  630. sub CORE_start
  631. {
  632.     my ( $self ) = @_;
  633.  
  634.     print "\n    Starting...     " if $self->{debug__};
  635.  
  636.     # Now that the configuration is set tell each module to begin operation
  637.  
  638.     # Make sure that the core is started first.
  639.     my @c = ( 'core', grep {!/^core$/} sort keys %{$self->{components__}} );
  640.  
  641.     foreach my $type (@c) {
  642.         print "\n         {$type:" if $self->{debug__};
  643.         foreach my $name (sort keys %{$self->{components__}{$type}}) {
  644.             my $code = $self->{components__}{$type}{$name}->start();
  645.  
  646.             if ( $code == 0 ) {
  647.                 die "Failed to start while starting the $name module";
  648.             }
  649.  
  650.             # If the module said that it didn't want to be loaded then
  651.             # unload it.
  652.  
  653.             if ( $code == 2 ) {
  654.                 delete $self->{components__}{$type}{$name};
  655.         } else {
  656.                 print " $name" if $self->{debug__};
  657.                 flush STDOUT;
  658.             }
  659.         }
  660.         print '} ' if $self->{debug__};
  661.     }
  662.  
  663.     print "\n\nPOPFile Engine ", scalar($self->CORE_version()), " running\n" if $self->{debug__};
  664.     flush STDOUT;
  665. }
  666.  
  667. #----------------------------------------------------------------------------
  668. #
  669. # CORE_service
  670. #
  671. # This is POPFile. Loops across POPFile's modules and executes their
  672. # service subroutines then sleeps briefly
  673. #
  674. # $nowait            If 1 then don't sleep and don't loop
  675. #
  676. #----------------------------------------------------------------------------
  677. sub CORE_service
  678. {
  679.     my ( $self, $nowait ) = @_;
  680.  
  681.     $nowait = 0 if ( !defined( $nowait ) );
  682.  
  683.     # MAIN LOOP - Call each module's service() method to all it to
  684.     #             handle its own requests
  685.  
  686.     while ( $self->{alive__} == 1 ) {
  687.         foreach my $type (sort keys %{$self->{components__}}) {
  688.             foreach my $name (sort keys %{$self->{components__}{$type}}) {
  689.                 if ( $self->{components__}{$type}{$name}->service() == 0 ) {
  690.                     $self->{alive__} = 0;
  691.                     last;
  692.                 }
  693.             }
  694.         }
  695.  
  696.         # Sleep for 0.05 of a second to ensure that POPFile does not
  697.         # hog the machine's CPU
  698.  
  699.         select(undef, undef, undef, 0.05) if !$nowait;
  700.  
  701.         # If we are on Windows then reap children here
  702.  
  703.         if ( $self->{on_windows__} ) {
  704.             foreach my $type (sort keys %{$self->{components__}}) {
  705.                 foreach my $name (sort keys %{$self->{components__}{$type}}) {
  706.                     $self->{components__}{$type}{$name}->reaper();
  707.                 }
  708.             }
  709.         }
  710.  
  711.         last if $nowait;
  712.     }
  713.  
  714.     return $self->{alive__};
  715. }
  716.  
  717. #----------------------------------------------------------------------------
  718. #
  719. # CORE_stop
  720. #
  721. # Loops across POPFile's modules and stops them
  722. #
  723. #----------------------------------------------------------------------------
  724. sub CORE_stop
  725. {
  726.     my ( $self ) = @_;
  727.  
  728.     if ( $self->{debug__} ) {
  729.         print "\n\nPOPFile Engine $self->{version_string__} stopping\n";
  730.         flush STDOUT;
  731.         print "\n    Stopping... ";
  732.     }
  733.  
  734.     # Shutdown the MQ first.  This is done so that it will flush out
  735.     # any remaining messages and hand them off to the other modules
  736.     # that might want to deal with them in their stop() routine
  737.  
  738.     $self->{components__}{core}{mq}->alive(0);
  739.     $self->{components__}{core}{mq}->stop();
  740.     $self->{components__}{core}{history}->alive(0);
  741.     $self->{components__}{core}{history}->stop();
  742.  
  743.     # Shutdown all the modules
  744.  
  745.     foreach my $type (sort keys %{$self->{components__}}) {
  746.         print "\n         {$type:" if $self->{debug__};
  747.         foreach my $name (sort keys %{$self->{components__}{$type}}) {
  748.             print " $name" if $self->{debug__};
  749.             flush STDOUT;
  750.             next if ( $name eq 'mq' );
  751.             next if ( $name eq 'history' );
  752.             $self->{components__}{$type}{$name}->alive(0);
  753.             $self->{components__}{$type}{$name}->stop();
  754.         }
  755.  
  756.         print '} ' if $self->{debug__};
  757.     }
  758.     print "\n\nPOPFile Engine $self->{version_string__} terminated\n" if $self->{debug__};
  759. }
  760.  
  761. #----------------------------------------------------------------------------
  762. #
  763. # CORE_version
  764. #
  765. # Gets and Sets POPFile's version data. Returns string in scalar
  766. # context, or (major, minor, build) triplet in list context
  767. #
  768. # $major_version        The major version number
  769. # $minor_version        The minor version number
  770. # $build_version        The build version number
  771. #
  772. #----------------------------------------------------------------------------
  773. sub CORE_version
  774. {
  775.     my ( $self, $major_version, $minor_version, $build_version ) = @_;
  776.  
  777.     if (!defined($major_version)) {
  778.         if (wantarray) {
  779.             return ($self->{major_version__},$self->{minor_version__},$self->{build_version__});
  780.         } else {
  781.             return $self->{version_string__};
  782.         }
  783.     } else {
  784.         ($self->{major_version__}, $self->{minor_version__}, $self->{build_version__}) = ($major_version, $minor_version, $build_version);
  785.         $self->{version_string__} = "v$major_version.$minor_version.$build_version"
  786.     }
  787. }
  788.  
  789. #----------------------------------------------------------------------------
  790. #
  791. # get_module
  792. #
  793. # Gets a module from components hash. Returns a handle to a module.
  794. #
  795. # May be called either as:
  796. #
  797. # $name     Module name in scoped format (eg, Classifier::Bayes)
  798. #
  799. # Or:
  800. #
  801. # $name     Name of the module
  802. # $type     The type of module
  803. #
  804. #----------------------------------------------------------------------------
  805. sub get_module
  806. {
  807.     my ( $self, $name, $type ) = @_;
  808.  
  809.     if (!defined($type) && $name =~ /^(.*)::(.*)$/ ) {
  810.         $type = lc($1);
  811.         $name = lc($2);
  812.  
  813.         $type =~ s/^POPFile$/core/i;
  814.     }
  815.  
  816.     return $self->{components__}{$type}{$name};
  817. }
  818.  
  819. #----------------------------------------------------------------------------
  820. #
  821. # set_module
  822. #
  823. # Inserts a module into components hash.
  824. #
  825. # $name     Name of the module
  826. # $type     The type of module
  827. # $module   A handle to a module
  828. #
  829. #----------------------------------------------------------------------------
  830. sub set_module
  831. {
  832.     my ($self, $type, $name, $module) = @_;
  833.  
  834.     $self->{components__}{$type}{$name} = $module;
  835. }
  836.  
  837. #----------------------------------------------------------------------------
  838. #
  839. # remove_module
  840. #
  841. # removes a module from components hash.
  842. #
  843. # $name     Name of the module
  844. # $type     The type of module
  845. # $module   A handle to a module
  846. #
  847. #----------------------------------------------------------------------------
  848. sub remove_module
  849. {
  850.     my ($self, $type, $name) = @_;
  851.  
  852.     $self->{components__}{$type}{$name}->stop();
  853.  
  854.     delete($self->{components__}{$type}{$name});
  855. }
  856.  
  857. #----------------------------------------------------------------------------
  858.  
  859. #
  860. # root_path__
  861. #
  862. # Joins the path passed in with the POPFile root
  863. #
  864. # $path             RHS of path
  865. #
  866. #----------------------------------------------------------------------------
  867.  
  868. sub root_path__
  869. {
  870.     my ( $self, $path ) = @_;
  871.  
  872.     $self->{popfile_root__}  =~ s/[\/\\]$//;
  873.     $path                    =~ s/^[\/\\]//;
  874.  
  875.     return "$self->{popfile_root__}/$path";
  876. }
  877.  
  878. # GETTER/SETTER
  879.  
  880. sub debug
  881. {
  882.     my ( $self, $debug ) = @_;
  883.  
  884.     $self->{debug__} = $debug;
  885. }
  886.  
  887. sub module_config
  888. {
  889.     my ( $self, $module, $item, $value ) = @_;
  890.  
  891.     return $self->{components__}{core}{config}->module_config_( $module, $item, $value );
  892. }
  893.  
  894. 1;
  895.  
  896.